home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 1992 August / info-mac-1992.iso / Language (lang) / Lazy-Scheme / Examples / TestandGenerate / Projet < prev   
Encoding:
Text File  |  1992-03-05  |  3.2 KB  |  112 lines  |  [TEXT/Help]
  1. {Just try the files cont* after having loaded this one (you should reload it eqch time)}
  2.  
  3. {Le moteur: un environnemnt - la liste des variables - domaines -contraintes (rangées)}
  4. {•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••}
  5.  
  6. (define (try env lv ld lc)
  7.  (cond (null? lv)'()
  8.        (let [(ne (maj env (0 lv) (0(0 ld))))]
  9.             (cond (tlc (0 lc) ne)
  10.                   (begin (printsol ne lv lc)
  11.                   (try ne (-1 lv) (-1 ld) (-1 lc))))
  12.             (cond (cons? (-1(0 ld)))
  13.                   (try env lv (cons (-1 (0 ld)) (-1 ld)) lc)))))
  14.  
  15. ;---- recopie et mise à jour d'un environnement
  16. (define (maj env var val)
  17.    (binding=! var (bcopy env) val))
  18.  
  19. ;---- vérifie si toutes les contraintes (lc) sont vraies dans env
  20. (define (tlc lc env)
  21.   (cond (null? lc) †
  22.         (eval (0 lc) env) (tlc (-1 lc) env)))
  23.  
  24. ;---- affiche la solution si elle existe
  25. (define (printsol env lv lc)
  26.    (cond (null? (-1 lv)) (begin (prinio "Solution:" stder)
  27.                                  (prinio env stder)
  28.                                  (prinio "
  29. " stder)
  30.                                  (flushio stder))))
  31.  
  32. ;---- I/F user
  33. (let [(lv (begin (prin "Liste des variables: ")  (flushio stdo)(read)))
  34.       (lc (begin (prin "Liste des contraintes :")(flushio stdo)(read)))
  35.       (ld (begin (prin "Liste des domaines: ")   (flushio stdo)(read)))]
  36.   (define (c)
  37.     (try (apply makeenv lv) lv ld (créelvc lv (process lc lv) '()))))
  38.  
  39. ;---- recherche o dans s (tous niveaux)
  40. (define (findall o s)
  41.    (cond (eq? o s) †
  42.          (not (cons? s)) ƒ
  43.          (findall o (0 s)) †
  44.          (findall o (-1 s))))            
  45.  
  46. ;---- extrait les variables dont dépendent les contraintes   
  47. ;---- retourne liste de doublets (lv | cont)   
  48. (define (process lc lv)
  49.    (cond (null? lc) ()
  50.          (cons (cons (extract (0 lc) lv '()) (0 lc))
  51.                      (process (-1 lc) lv))))
  52.  
  53. (define (extract c lv bag)
  54.    (cond (null? lv) bag
  55.          (findall (0 lv) c) (extract c (-1 lv) (cons (0 lv) bag))
  56.          (extract c (-1 lv) bag)))
  57.  
  58. ;---- est dans 
  59. (define (isinq el l)
  60.   (cond (null? l) ƒ
  61.         (eq? el (0 l)) †
  62.         (isinq el (-1 l))))
  63.  
  64.  
  65. ;---- est inclus
  66. (define (isincluded e1 e2)
  67.    (cond (null? e1) †
  68.          (isinq (0 e1) e2) (isincluded (-1 e1) e2)))
  69.  
  70. ;---- creer la liste (var contraintes)
  71. (define (créelvc lv lc b0)
  72.    (cond (null? lv) '()
  73.          (let [(x (trclv (0 lv) lc (cons (0 lv) b0) '() '()))]
  74.               (cons (-1 x)
  75.                     (créelvc (-1 lv) (0 x) (cons (0 lv) b0))))))
  76.  
  77.  (define (trclv v nlc e b1 b2)
  78.         (cond (null? nlc) (cons b2 b1)
  79.               (isincluded (0(0 nlc)) e) (trclv v (-1 nlc) e (cons (-1(0 nlc)) b1) b2)
  80.               (trclv v (-1 nlc) e  b1 (cons (0 nlc) b2))))
  81.  
  82. ;---- application d'un op binaire a tous
  83. (define (genbin sym lv)
  84.   (cond (null? lv) ()
  85.         (append (mapcar1 (lambda(x) (list sym (0 lv) x)) (-1 lv))
  86.                    (genbin (-1 lv)))))
  87.  
  88. (define (mapcar1 f l)
  89.      (cond (null? l)()
  90.            (cons (f (0 l))
  91.                        (mapcar1 f (-1 l)))))
  92.  
  93. ;---- extension en logique prop
  94.  
  95. (define (ou a b)
  96.   (cond (=? a 0) b 1))
  97.  
  98. (define (non a)
  99.   (cond (=? a 0) 1 0))
  100.  
  101. (define (et a b)
  102.   (cond (=? a 0) 0 b))
  103.  
  104. (define (implique a b)
  105.   (cond (=? a 0) 1 b))
  106.  
  107. (define (vrai? a)
  108.   (=? a 1))
  109.  
  110. (define (faux? a)
  111.    (=? a 0))
  112.